(* ocamlfind ocamlc -o josephus -package extlib,kw -linkpkg josephus.ml *) (* ocamlfind ocamlopt -o josephus -package extlib,kw -linkpkg josephus.ml *) open Kw open Printf (* print usage message *) let usage = sprintf "Usage: %s [-all | -graphic] [-delay FLOAT] N M" let nm = ref [] (* [number of rebels; gap] *) let all = ref false let graphic = ref false let delay = ref 0.1 let speclist = [ ("-all", Arg.Unit (fun () -> all := true), (sprintf ": print all suicides; last is survivor (default: %s)" (string_of_bool !all))); ("-graphic", Arg.Unit (fun () -> graphic := true), (sprintf ": \"graphic\" display of process (default: %s)" (string_of_bool !graphic))); ("-delay", Arg.Float (fun f -> delay := f), (sprintf "FLOAT: delay (seconds) between suicides for -graphic (default: %f)" !delay)); ] (* return number of survivor *) let josephus n m = let rec j circle = if Dllist.length circle = 1 then Dllist.get circle else j (Dllist.drop (Dllist.skip circle (m-1))) in j (Dllist.of_list (1--n)) (* return number of survivor, size-tracking optimization *) (* only twice as fast *) let josephus n m = let rec j size circle = if size = 1 then Dllist.get circle else j (size-1) (Dllist.drop (Dllist.skip circle (m-1))) in let dl = Dllist.of_list (1--n) in j (Dllist.length dl) dl (* return number of survivor, size-tracking optimization, more efficient initialization *) let josephus n m = let init n = let rec init' circle = let i = Dllist.get circle in if i = 1 then circle else init' (Dllist.prepend circle (i-1)) in init' (Dllist.create n) in let rec j size circle = if size = 1 then Dllist.get circle else j (size-1) (Dllist.drop (Dllist.skip circle (m-1))) in j n (init n) (* return list of suicides in order; last "suicide" is survivor *) let josephus'all n m = let rec j circle acc = if Dllist.length circle = 1 then (Dllist.get circle)::acc else let dead = Dllist.skip circle (m-1) in j (Dllist.drop dead) (Dllist.get dead::acc) in List.rev (j (Dllist.of_list (1--n)) []) (* graphical version *) let josephus'graphic n m = let width = int_of_float (ceil (log10 (float n))) in let print display = Array.iter (fun s -> print_string s; print_char ' ') display; print_char '\r'; flush stdout; ignore (Unix.select [] [] [] !delay) in let rec j circle display = if Dllist.length circle = 1 then print_newline () else let dead = Dllist.skip circle (m-1) in let i = Dllist.get dead in display.(i-1) <- String.make width 'x'; print display; j (Dllist.drop dead) display in let display = Array.make n "" in for i = 0 to n-1 do display.(i) <- sprintf "%*d" width (i+1) done; print display; j (Dllist.of_list (1--n)) display (* command-line arg parsing etc*) exception Usage let main () = let collect x = nm := !nm @ [x] in let msg = (usage (Filename.basename Sys.argv.(0))) in let _ = Arg.parse speclist collect msg in try match !nm with | [n;m] -> begin let n, m = int_of_string n, int_of_string m in match !all, !graphic with | true,true -> raise Usage | true,false -> List.iter (printf "%d\n") (josephus'all n m) | false,true -> josephus'graphic n m | false,false -> printf "%d\n" (josephus n m) end | _ -> raise Usage with Usage -> prerr_endline msg; exit 1 let () = main ()